home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 9 / Night Owl CD-ROM (NOPV9) (Night Owl Publisher) (1993).ISO / 012a / lib194.zip / STATS.PRG < prev    next >
Text File  |  1992-12-23  |  26KB  |  594 lines
  1. *-------------------------------------------------------------------------------
  2. *-- Program...: STATS.PRG
  3. *-- Programmer: Ken Mayer (CIS: 71333,1030) and Jay Parsons (CIS: 70160,340)
  4. *-- Date......: 06/25/1992
  5. *-- Notes.....: Statistical Functions -- see README.TXT to include this 
  6. *--             library file in your system.
  7. *-------------------------------------------------------------------------------
  8.  
  9. FUNCTION Samplevar
  10. *-------------------------------------------------------------------------------
  11. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  12. *-- Date........: 4/13/1992
  13. *-- Notes.......: Finds sample variance of specified field of the current
  14. *--             : database, using CALCULATE command.
  15. *--             : The CALCULATE command calculates the population variance,
  16. *--             : which is smaller by a factor of (n-1)/n.
  17. *--             :
  18. *-- Written for.: dBASE IV Version 1.5
  19. *-- Rev. History: Original function 1990.
  20. *--             : Modified to take optional parameter, 4/13/1992
  21. *-- Calls       : None
  22. *-- Called by...: Any
  23. *-- Usage.......: Samplevar( <cField> [, <cClause> ] )
  24. *-- Example.....: ? Samplevar( "Balance", ".FOR..NOT. isblank( Balance )" )
  25. *-- Returns     : a numeric or float value, the sample variance, or .F. if
  26. *--             : it cannot be calculated.
  27. *--             : If any of the numeric items are floats, the result will be.
  28. *-- Parameters..: cField, name of a numeric field of the current database
  29. *--             : for which to calculate the sample variance
  30. *--             : cClause, optional, a FOR, WHILE, TO, etc. clause
  31. *-------------------------------------------------------------------------------
  32.    PARAMETERS cField, cCondition
  33.    PRIVATE fVar, nCount, cCond
  34.    IF pcount() = 2
  35.       cCond = " "+ cCondition
  36.    ELSE
  37.       cCond = ""
  38.    ENDIF
  39.    CALCULATE VAR( &cField ), CNT() TO fVar, nCount &cCond
  40.  
  41. RETURN iif( nCount > 1, fVar * nCount / ( nCount - 1 ), .F. )
  42. *-- Eof: Samplevar()
  43.  
  44. FUNCTION Stny
  45. *-------------------------------------------------------------------------------
  46. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  47. *-- Date........: 11/13/1990
  48. *-- Notes.......: Returns value of the standard normal distribution function
  49. *--             : given a number of standard deviations from the mean.
  50. *--             : This function is not useful alone.  The standard normal
  51. *--             : distribution function is the familiar bell-shaped curve
  52. *--             : scaled so its mean is at 0, each standard deviation is 1
  53. *--             : and the total area under the curve is 1.  The function
  54. *--             : Stnarea calls on this function to calculate the approximate
  55. *--             : area (a fraction equal to percent of the total) under the
  56. *--             : part of the curve lying betwen the mean and the given
  57. *--             : number of standard deviations.
  58. *--             :
  59. *-- Written for.: dBASE IV
  60. *-- Rev. History: None
  61. *-- Calls       : None
  62. *-- Called by...: Any
  63. *-- Usage.......: Stny( <nDevs> )
  64. *-- Example.....: ? Stny( 1 )
  65. *-- Returns     : numeric value of the function.
  66. *-- Parameters..: nDevs, standard deviations from the mean
  67. *-------------------------------------------------------------------------------
  68.    PARAMETERS nDevs
  69.  
  70. RETURN exp( -nDevs * nDevs / 2 ) / sqrt( 2 * pi() )
  71. *-- EoF: Stny()
  72.  
  73. FUNCTION Stnarea
  74. *-------------------------------------------------------------------------------
  75. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  76. *-- Date........: 11/13/1990
  77. *-- Notes.......: Area of the standard normal distribution function between
  78. *--             : mean and given number of standard deviations from the mean.
  79. *--             :
  80. *--             : What's it about?  Well, College Board scores (originally)
  81. *--             : were based on a normal distribution with a mean of 500 and
  82. *--             : 100 points per standard deviation.  Knowing that a 650
  83. *--             : score is 1.5 standard deviations from the 500 mean, we
  84. *--             : can calculate Stnarea( 1.5 ) as .4332.  This tells us that
  85. *--             : 43.32% of the scores lie between 650 and 500.  Since 50%
  86. *--             : lie below 500, a score of 650 beats 93.32% of the scores.
  87. *--             :
  88. *--             : The polynomial approximation used by this function is said
  89. *--             : to be accurate to .00001, 1/1000 of one percent.  Remember
  90. *--             : to SET DECIMALS appropriately to view results.
  91. *--             :
  92. *-- Written for.: dBASE IV
  93. *-- Rev. History: None
  94. *-- Calls       : Stny()            Function in STATS.PRG
  95. *-- Called by...: Any
  96. *-- Usage.......: Stnarea( <nDevs> )
  97. *-- Example.....: ? Stnarea( 1.5 )
  98. *-- Returns     : % of area between deviations given and the mean, 0<=a<.5.
  99. *-- Parameters..: nDevs, standard deviations from the mean
  100. *-------------------------------------------------------------------------------
  101.    PARAMETERS nDevs
  102.    PRIVATE nX, nV
  103.    nX = abs( nDevs )
  104.    nV =  1 / ( 1 + .33267 * nX )
  105.  
  106. RETURN .5 - Stny( nX ) * ( .4361836  * nV - .1201676 * nV * nV ;
  107.      + .937298 * nV * nV * nV )
  108. *-- EoF: Stnarea()
  109.  
  110. FUNCTION Stnz
  111. *-------------------------------------------------------------------------------
  112. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  113. *-- Date........: 11/13/1990
  114. *-- Notes.......: A lookup table to find the values of "z", standard
  115. *--             : deviations, corresponding to the most common areas inside a
  116. *--             : given number of tails of the normal distribution function.
  117. *--             :
  118. *--             : Used in testing confidence intervals.  If a sample of
  119. *--             : light bulbs from a shipment shows an average life of 1150
  120. *--             : hours, and the criterion for rejection of the shipment is
  121. *--             : 95% confidence that the average life of all bulbs is less
  122. *--             : than (a single tail) 1200 hours, the value 1.64485 returned
  123. *--             : by this function is necessary to determine whether to
  124. *--             : reject the shipment or not.
  125. *--             :
  126. *--             : Values of "z" that are not found in the table can be found
  127. *--             : using Stndevs, below, but it is slow.
  128. *--             :
  129. *-- Written for.: dBASE IV
  130. *-- Rev. History: None
  131. *-- Calls       : None
  132. *-- Called by...: Any
  133. *-- Usage.......: Stnz( <nProb>, <nTails> )
  134. *-- Example.....: ? Stnz( .95, 1 )
  135. *-- Returns     : z, number of standard deviations from mean inside which
  136. *--             : ( or to the side of which includes the mean, if one tail)
  137. *--             : the given percentage of area will fall.
  138. *--             : Returns -1 if no entry in table.
  139. *-- Parameters..: nConf, confidence desired, 0 < nConf < 1
  140. *--             : nTails, 1 or 2 = number of tails of curve of interest
  141. *-------------------------------------------------------------------------------
  142.    PARAMETERS nConf, nTails
  143.    IF nTails # 1 .AND. nTails # 2
  144.       RETURN -1
  145.    ENDIF
  146.    DO CASE
  147.       CASE nConf = .95
  148.          RETURN iif( nTails = 1, 1.64485, 1.96010 )
  149.       CASE nConf = .99
  150.          RETURN iif( nTails = 1, 2.32676, 2.57648 )
  151.       CASE nConf = .995
  152.          RETURN iif( nTails = 1, 2.57648, 2.80794 )
  153.       CASE nConf = .999
  154.          RETURN iif( nTails = 1, 3.09147, 3.29202 )
  155.       OTHERWISE
  156.          RETURN -1
  157.    ENDCASE
  158.  
  159. *-- EoF: Stnz()
  160.  
  161. FUNCTION Stndiff
  162. *-------------------------------------------------------------------------------
  163. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  164. *-- Date........: 4/13/1992
  165. *-- Notes.......: Determines whether hypothesis that sample of a given mean
  166. *--               is different from expected mean is justified.
  167. *--
  168. *--               If nPopstd, the standard deviation of the population, is
  169. *--               not known and nSample, the sample size, is greater than
  170. *--               30, the sample standard deviation may be used for nPopstd.
  171. *--
  172. *--               This function assumes the population is large relative to
  173. *--               the sample or that the sampling is with replacement.  If
  174. *--               neither is true, the right side of the expression in the
  175. *--               later return line should be multiplied by:
  176. *--                     sqrt( ( nPop - nSample ) / ( nPop - 1 ) )
  177. *--               where nPop is the size of the population.
  178. *--
  179. *--               Do not use this with small samples, less than 20, because
  180. *--               the standard normal distribution is not sufficiently
  181. *--               accurate as an approximation of the distribution of sample
  182. *--               means in such a case.  See "Student's T-distribution" in a
  183. *--               statistics text.
  184. *--
  185. *-- Written for.: dBASE IV Version 1.5
  186. *-- Rev. History: None.
  187. *-- Calls       : Stnz()            Function in STATS.PRG
  188. *-- Called by...: Any
  189. *-- Usage.......: Stndiff( <nConf>, <nTails>, <nSample>, <nSampmean>, ;
  190. *--             :    <nPopmean>, <nPopstd> )
  191. *-- Example.....: ? Stndiff( .95, 1, 30, 1150, 1200, 20 )
  192. *-- Returns     : .T. if hypothesis of difference is justified to degree of
  193. *--             : confidence specified, or .F.  Returns -1 if confidence is
  194. *--             : not one for which z can be looked up in Stnz().  If you
  195. *--             : need other confidence levels, run Stndevs() to find the
  196. *--             : z values for them and add them to the Stnz() table.
  197. *-- Parameters..: nConf, confidence desired, 0 < nConf < 1
  198. *--             : nTails, 1 or 2 = number of tails of curve of interest
  199. *--             : nSample, number of items in the sample
  200. *--             : nSampmean, mean of the sample
  201. *--             : nPopmean, mean of the population ( test standard mean )
  202. *--             : nPopstd, standard deviation of population
  203. *-------------------------------------------------------------------------------
  204.    PARAMETERS nConf, nTails, nSample, nSampmean, ;
  205.               nPopmean, nPopstd
  206.    PRIVATE nStd
  207.    nStd = Stnz( nConf, nTails )
  208.    IF nStd = -1
  209.       RETURN nStd
  210.    ELSE
  211.       RETURN abs( nSampmean - nPopmean ) ;
  212.                  > nStd * nPopstd / sqrt( nSample )
  213.    ENDIF
  214. *-- EoF: Stndiff()
  215.  
  216. FUNCTION Stndevs
  217. *-------------------------------------------------------------------------------
  218. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  219. *-- Date........: 4/13/1992
  220. *-- Notes.......: Calculates "z", standard deviations, corresponding to any
  221. *--             : area of standard normal curve between mean and the desired
  222. *--             : z. Much slower than Stnz().
  223. *-- Written for.: dBASE IV Version 1.5
  224. *-- Rev. History: Original function 1990.
  225. *--             : Conformed to Zeroin() 4/13/1992.
  226. *-- Calls       : Zeroin()          Function in STATS.PRG 
  227. *-- Called by...: Any
  228. *-- Usage.......: Stndevs( <nArea> )
  229. *-- Example.....: ? Stndevs( .96 )
  230. *-- Returns     : z, number of standard deviations from mean, or a negative
  231. *--             : number indicating failure to find a root..
  232. *-- Parameters..: nArea, area "left" of point of interest, .5 < nArea < 1
  233. *-------------------------------------------------------------------------------
  234.    PARAMETERS nArea
  235.    PRIVATE nTest, nFlag
  236.    IF nArea > .99999 .OR. nArea < .5
  237.       RETURN -1
  238.    ENDIF
  239.    nFlag = 0
  240.    nTest = Zeroin( "Tstnarea", 0, 4.2, float(1/100000), 100, nFlag, nArea )
  241.  
  242. RETURN iif( nFlag < 3, nTest, -nFlag )
  243. *-- EoF: Stndevs()
  244.  
  245. FUNCTION Tstnarea
  246. *-------------------------------------------------------------------------------
  247. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  248. *-- Date........: 11/13/1990
  249. *-- Notes.......: Translation function to convert area to left of point
  250. *--             : under standard normal curve to 0 for Zeroin().
  251. *-- Written for.: dBASE IV
  252. *-- Rev. History: None
  253. *-- Calls       : Stnarea()         Function in STATS.PRG
  254. *-- Called by...: Any
  255. *-- Usage.......: Tstnarea( <nDevs>, <nArea> )
  256. *-- Example.....: ? Tstnarea( 1.6,.96 )
  257. *-- Returns     : positive or negative number corresponding to direction to
  258. *--             : root where nArea = Stnarea
  259. *-- Parameters..: nDevs, trial number of standard deviations
  260. *--             : nArea, area for which deviations are to be found
  261. *-------------------------------------------------------------------------------
  262.    PARAMETERS nDevs, nArea
  263.  
  264. RETURN Stnarea( nDevs ) +.5 - nArea
  265. *-- EoF: Tstnarea()
  266.  
  267. FUNCTION Zeroin
  268. *-------------------------------------------------------------------------------
  269. *-- Programmer..: Tony Lima (CIS: 72331,3724) and Jay Parsons (CIS: 70160,340)
  270. *-- Date........: 04/13/1992
  271. *-- Notes.......: Finds a zero of a continuous function.
  272. *--             : In substance, what this function does is close in on a
  273. *--             : solution to a function that cannot otherwise be solved.
  274. *--             : Assuming Y = f(X), if Y1 and Y2, the values of the function
  275. *--             : for X1 and X2, have different signs, there must be at least
  276. *--             : one value of X between X1 and X2 for which Y = 0, if the
  277. *--             : function is continuous.  This function closes in on such a
  278. *--             : value of X by a trial-and-error process.
  279. *--             :
  280. *--             : This function is very slow, so a maximum number of iterations
  281. *--             : is passed as a parameter.  If the number of iterations is
  282. *--             : exceeded, the function will fail to find a root.  If this
  283. *--             : occurs, pick different original "X" values, increase the
  284. *--             : number of iterations or increase the errors allowed.  Once
  285. *--             : an approximate root is found, you can use values of X close
  286. *--             : on either side and reduce the error allowed to find an
  287. *--             : improved solution.  Also, of course, the signs of Y must be
  288. *--             : different for the starting X values for the function to
  289. *--             : proceed at all.
  290. *--             :
  291. *--             : NOTE ESPECIALLY - There is NO guarantee that a root returned
  292. *--             : by this function is the only one, or the most meaningful.
  293. *--             : It depends on the function that this function calls, but if
  294. *--             : that function has several roots, any of them may be returned.
  295. *--             : This can easily happen with such called functions as net
  296. *--             : present value where the cash flows alternate from positive
  297. *--             : to negative and back, and in many other "real life" cases.
  298. *--             : See the discussion of @IRR in the documentation of a good
  299. *--             : spreadsheet program such as Quattro Pro for further
  300. *--             : information.
  301. *--             :
  302. *--             : The method used by this function is a "secant and bisect"
  303. *--             : search.  The "secant" is the line connecting two X,Y
  304. *--             : points on a graph using standard Cartesian coordinates.
  305. *--             : Where the secant crosses the X axis is the best guess for
  306. *--             : the value of X that will have Y = 0, and will be correct
  307. *--             : if the function is linear between the two points.  The
  308. *--             : basic strategy is to calculate Y at that value of X, then
  309. *--             : keep the new X and that one of the old X values that had
  310. *--             : a Y-value of opposite sign, and reiterate to close in.
  311. *--             :
  312. *--             : If the function is a simple curve with most of the change
  313. *--             : in Y close to one of the X-values, as often occurs if the
  314. *--             : initial values of X are poorly chosen, repeated secants
  315. *--             : will do little to find a Y-value close to zero and will
  316. *--             : reduce the difference in X-values only slightly.  In this
  317. *--             : case the function shifts to choosing the new X halfway
  318. *--             : between the old ones, bisecting the difference and always
  319. *--             : reducing the bracket by half, for a while.
  320. *--             :
  321. *--             : While this function finds a "zero", it may be used to
  322. *--             : find an X corresponding to any other value of Y.  Suppose
  323. *--             : the function of X is FUNCTION Blackbox( X ) and it is
  324. *--             : desired to find a value of X for which f(X) = 7.  The trick
  325. *--             : is to interpose a function between Zeroin() and Blackbox()
  326. *--             : that will return a 0 to Zeroin() whenever Blackbox() returns
  327. *--             : 7.  By calling that function, Zeroin() finds a value of
  328. *--             : X for which Blackbox( X ) = 7, as required:
  329. *--             :    Result = Zeroin( "Temp", <other parameters omitted> )
  330. *--             :
  331. *--             :    FUNCTION Temp
  332. *--             :    parameters nQ
  333. *--             :    RETURN Blackbox( nQ ) - 7
  334. *--             :
  335. *-- Written for.: dBASE IV Version 1.5
  336. *-- Rev. History: Original function 1990.
  337. *--             : Modified to take optional parameters, 4/13/1992
  338. *-- Calls       : The function whose name is first parameter.
  339. *--             : NPV()             Function in FINANCE.PRG
  340. *-- Called by...: Any
  341. *-- Usage.......: Zeroin( <cFunction>, <fX1>, <fX2>, <fAbserror>, ;
  342. *--             :  <nMaxiter>, <n_Flag> ;
  343. *--             :  [, xPass1 [, xPass2 [, xPass3 ] ] ] )
  344. *-- Example.....: ? Zeroin( "Npv", 0, 200, .000001, 200, n_Flag, 11 )
  345. *-- Returns     : a float value representing a root, if n_Flag < 3.
  346. *-- Parameters..: cFunction, the name of the function to solve for a root.
  347. *--               fX1, one of the X-values between which the root is sought.
  348. *--               fX2, the second of these values.
  349. *--               Note: These MUST be chosen so the f( X ) values for the two
  350. *--               of them have opposite signs (they must bracket the result).
  351. *--               fAbserror, the absolute error allowed in the result.
  352. *--               nMaxiter, the maximum number of times to iterate.
  353. *--               n_Flag, an integer to signal success ( < 3 ) or failure.
  354. *--               xPass1 . . . 3, arguments to be passed through to cFunction.
  355. *--               The parameter "n_Flag" should be passed as a variable so it
  356. *--               may be accessed on return.  The limit of 9 literal parameters
  357. *--               may require passing others as variables.  The "xPass"
  358. *--               parameters are optional and the fact there are three of them
  359. *--               is arbitrary; they exist to hold whatever parameters may be
  360. *--               needed by the function cFunction being called aside from
  361. *--               the value of X for which it is being evaluated.  Add more
  362. *--               and change the 3 "&cFunc." lines below if you need more.
  363. *-- Side effects: Uses and alters a global numeric variable, here called
  364. *--               "n_Flag", to report error conditions resulting in value
  365. *--               returned being meaningless.  Possible n_Flag values are:
  366. *--                     1       success - root found within error allowed
  367. *--                     2       success - root was found exactly
  368. *--                     3       error   - function value not converging
  369. *--                     4       error   - original values do not bracket a root
  370. *--                     5       error   - maximum iterations exceeded
  371. *-------------------------------------------------------------------------------
  372.    parameters cFunc, fNearx, fFarx, fAbserr, nMaxiter, ;
  373.               n_Flag, xPass1, xPass2, xPass3
  374.    private nSplits, fBracket, fFary, fNeary, nIters
  375.    private fMaxabs, fOldx, fOldy, fDiffx, fAbsdiff, fSecant
  376.  
  377.    store 0 to nSplits, nIters
  378.    fBracket = abs ( fNearx - fFarx )
  379.    fFary = &cFunc.( fFarx, xPass1, xPass2, xPass3 )
  380.    fNeary = &cFunc.( fNearx, xPass1, xPass2, xPass3 )
  381.  
  382.    if sign( fNeary ) = sign( fFary )
  383.       n_Flag = 4
  384.       return float(0)
  385.    endif
  386.  
  387.    fMaxabs = max( abs( fNeary ), abs( fFary ) )
  388.    n_Flag = 0
  389.  
  390.    * Main iteration loop
  391.  
  392.    do while .t.
  393.  
  394.       if abs( fFary ) < abs( fNeary )
  395.  
  396.          * Interchange fNearx and fFarx so that
  397.          * fNearx is closer to a solution--
  398.          * abs( fNeary ) <= abs( fFary )
  399.  
  400.          fOldx  = fNearx
  401.          fOldy  = fNeary
  402.          fNearx = fFarx
  403.          fNeary = fFary
  404.          fFarx  = fOldx
  405.          fFary  = fOldy
  406.       endif
  407.  
  408.       fDiffx = fFarx - fNearx
  409.       fAbsdiff = abs( fDiffx )
  410.  
  411.       * Test whether interval is too small to continue
  412.  
  413.       if fAbsdiff <= 2 * fAbserr
  414.          if abs( fNeary ) > fMaxabs
  415.  
  416.             * Yes, but we are out of bounds
  417.  
  418.             n_Flag = 3
  419.             fNearx = float(0)
  420.          else
  421.  
  422.             * Yes, and we have a solution!
  423.  
  424.             n_Flag = 1
  425.          endif
  426.          exit
  427.       endif
  428.  
  429.       * Save the last approximation to x and y
  430.  
  431.       fOldx = fNearx
  432.       fOldy = fNeary
  433.  
  434.       * Check if reduction in the size of
  435.       * bracketing interval is satisfactory.
  436.       * If not, bisect until it is.
  437.  
  438.       nSplits = nSplits + 1
  439.       if nSplits >= 4
  440.          if 4 * fAbsdiff >= fBracket
  441.             fNearx = fNearx + fDiffx / 2
  442.          else
  443.             nSplits = 0
  444.             fBracket = fAbsdiff / 2
  445.  
  446.             * Calculate secant
  447.  
  448.             fSecant = ( fNearx - fFarx ) * fNeary ;
  449.                                / ( fFary - fNeary )
  450.  
  451.             * But not less than error allowed
  452.  
  453.             if abs( fSecant ) < fAbserr
  454.                fNearx = fnearx + fAbserr * sign( fDiffx )
  455.             else
  456.                fNearx = fNearx + fSecant
  457.             endif
  458.          endif
  459.       endif
  460.  
  461.       * Evaluate the function at the new approximation
  462.  
  463.       fNeary = &cFunc.( fNearx, xPass1, xPass2, xPass3 )
  464.  
  465.       * If it's exactly zero, we win!  Run with it
  466.  
  467.       if fNeary = 0.00
  468.          n_Flag = 2
  469.          exit
  470.       endif
  471.  
  472.       * Else adjust iteration count and quit if too
  473.       * many iterations with no solution
  474.  
  475.       nIters = nIters + 1
  476.       if nIters > nMaxiter
  477.          n_Flag = 5
  478.          fNearx = float( 0 )
  479.          exit
  480.       endif
  481.  
  482.       * And finally keep as the new fFarx that one
  483.       * of the previous approximations, fFarx and
  484.       * fOldx, at which the function has a sign opposite
  485.       * to that at the new approximation, fNearx.
  486.  
  487.       if sign( fNeary ) = sign( fFary )
  488.          fFarx = fOldx
  489.          fFary = fOldy
  490.       endif
  491.    enddo
  492.  
  493. RETURN fNearx
  494. *-- EoF: Zeroin()
  495.  
  496. *-------------------------------------------------------------------------------
  497. *-- The functions below are here by courtesy ... (to make life easier on the
  498. *-- poor programmer ...)
  499. *-------------------------------------------------------------------------------
  500.  
  501. FUNCTION Npv
  502. *-------------------------------------------------------------------------------
  503. *-- Programmer..: Tony Lima (CIS: 72331,3724) and Jay Parsons (CIS: 70160,340)
  504. *-- Date........: 03/01/1992
  505. *-- Notes.......: Net present value of array aCashflow[ nPeriods ]
  506. *--               Calculates npv given assumed rate and # periods.
  507. *-- Written for.: dBASE IV, 1.1
  508. *-- Rev. History: None
  509. *-- Calls.......: None
  510. *-- Called by...: Any
  511. *-- Usage.......: NPV(<nRate>,<nPeriods>)
  512. *-- Example.....: ? NPV( .06, 6 )
  513. *-- Returns.....: Float = value of the project at given rate
  514. *-- Parameters..: nRate    = Interest Rate
  515. *--             : nPeriods = Number of Periods to calculate for
  516. *-- Other inputs: Requires the array aCashflow[ ] set up before calling.
  517. *--             : Each of its elements [n] holds the cash flow at the
  518. *--             : beginning of period n, with a negative amount indicating
  519. *--             : a cash outflow.  Elements of value 0 must be included for
  520. *--             : all periods with no cash flow, and all periods must be of
  521. *--             : equal length.
  522. *--             : If the project is expected to require an immediate outlay
  523. *--             : of $6,000 and to return $2,000 at the end of each of the
  524. *--             : first five years thereafter, the array will be:
  525. *--             :       aCashflow[1] = -6000
  526. *--             :       aCashflow[2] =  2000
  527. *--             :       aCashflow[3] =  2000
  528. *--             :           * * *
  529. *--             :       aCashflow[6] =  2000
  530. *--             : Rewriting function to have array name passed as a parameter
  531. *--             : is possible, but will slow down execution to an extent that
  532. *--             : will be very noticeable if this function is being repeatedly
  533. *--             : executed, as by Zeroin() to find an Internal Rate of Return.
  534. *-------------------------------------------------------------------------------
  535.  
  536.     parameters nRate, nPeriods
  537.     private nDiscount, nFactor, nPeriod, nNpv
  538.     nPeriod = 1
  539.     nNpv = aCashflow[ 1 ]
  540.     nDiscount = float( 1 )
  541.     nFactor = 1 / ( 1 + nRate )
  542.     do while nPeriod < nPeriods
  543.         nPeriod = nPeriod + 1
  544.         nDiscount = nDiscount * nFactor
  545.         nNpv = nNpv + aCashflow[ nPeriod ] * nDiscount
  546.     enddo
  547.     
  548. RETURN nNpv
  549. *-- EoF: Npv()
  550.  
  551. FUNCTION ArrayRows
  552. *-------------------------------------------------------------------------------
  553. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  554. *-- Date........: 03/01/1992
  555. *-- Notes.......: Number of Rows in an array
  556. *-- Written for.: dBASE IV, 1.1
  557. *-- Rev. History: None
  558. *-- Calls.......: None
  559. *-- Called by...: Any
  560. *-- Usage.......: ArrayRows("<aArray>")
  561. *-- Example.....: n = ArrayRows("aTest")
  562. *-- Returns.....: numeric
  563. *-- Parameters..: aArray      = Name of array 
  564. *-------------------------------------------------------------------------------
  565.  
  566.     parameters aArray
  567.     private nHi, nLo, nTrial, nDims
  568.     nLo = 1
  569.     nHi = 1170
  570.     if type( "&aArray[ 1, 1 ]" ) = "U"
  571.       nDims = 1
  572.     else
  573.      nDims = 2
  574.     endif
  575.     do while .T.
  576.      nTrial = int( ( nHi + nLo ) / 2 )
  577.       if nHi < nLo
  578.         exit
  579.       endif
  580.      if nDims = 1 .and. type( "&aArray[ nTrial ]" ) = "U" .or. ;
  581.        nDims = 2 .and. type( "&aArray[ nTrial, 1 ]" ) = "U"
  582.         nHi = nTrial - 1
  583.       else
  584.         nLo = nTrial + 1
  585.       endif
  586.     enddo
  587.     
  588. RETURN nTrial
  589. *-- EoF: ArrayRows()
  590.  
  591. *-------------------------------------------------------------------------------
  592. *-- End of Program: STATS.PRG
  593. *-------------------------------------------------------------------------------
  594.